COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE BEAMX
C00008 ENDMK
C⊗;
	TITLE BEAMX
	ENTRY BEAMX	;	SUBROUTINE BEAMX
	EXTERNAL .COMM.,STF,BMSTF,AMOD
;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /STF/RSTFAC(0/7),RSTJ2
;	EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),
;	1 (R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(R7,RJQ(5))
;	1,(R3,RJQ(1)),(J8,JQ(6)),(J7,JQ(5))
;	1,(R11,RJQ(9)),(R10,RJQ(8)),(R8,RJQ(6)),(RJ3,RJJ(1))
;	1,(R9,RJQ(7)),(J9,JQ(7))

BEAMX:	0
	MOVE 1,.COMM.+=31	;IF(J10.GE.100)GO TO 6
	CAIL 1,=100		;CALL BMSTF
	JRST BM6		;RETURN
	JSA 16,BMSTF
	JRA 16,(16)
BM6:	MOVNI 1,2		;6	JZ=-2
	MOVEM 1,JZ#
	KIFIX 1,.COMM.+=9 	;JX8=R8
	CAML 1,[-1]		;IF(JX8.GE.-1)GO TO 16
	JRST BM16
	MOVE 14,.COMM.+=9	;JX8=R8/10.0
	FDVR 14,[10.0]
	KIFIX 14,14
	IMULI 14,=10		;JX8=JX8*10    C MAKE SURE LAST DIGIT IS ZERO
	MOVEM 14,JX8#
	FLTR 14,14		;R8=JX8
	MOVEM 14,.COMM.+=9
BM16:	MOVE 13,.COMM.+=9	;16	RR8=R8
	MOVEM 13,RR8#
	SETZM .COMM.+=9		;R8=0
	MOVE 12,.COMM.+=10	;RR9=R9
	MOVEM 12,RR9#
	SETZM .COMM.+=10	;R9=0
	MOVE 6,.COMM.+=7	;RR6=R6
	MOVEM 6,RR6#
	MOVE 3,.COMM.+=4	;RR3=R3
	MOVEM 3,RR3#
	MOVE 4,.COMM.+=5	;RR4=R4
	MOVEM 4,RR4#
	MOVE 5,.COMM.+=6	;RR5=R5
	MOVEM 5,RR5#
	MOVE 11,STF+=8		;RSTJ=RSTJ2
	MOVEM 11,RSTJ#
	MOVE .COMM.+=28		;J=10*(J7/10)
	IDIVI =10		;C J=STEM DIR. (10 OR 20)
	IMULI =10		;J IS IN AC0
	MOVEM J#
	MOVE 1,10		;JJ=J10/100
	IDIVI 1,=100		;JJ IS IN AC1
	MOVEM 1,JJ#
	IMULI 1,=100		;JJ10=J10-JJ*100
	SUB 1,10
	MOVNM 1,JJ10#
; IF 3RD DIGIT OF P10 = 0, THEN TWO SECONDARY BEAM GROUPS ARE MADE.
;  THEN P8 AND P9 ARE THE LIMITS OF THE GAP BETWEEN THE SECONDARY GROUPS.

; IF 3RD DIGIT OF P10 = 1, THEN SINGLE SECONDARY BEAM GROUP IS MADE.
;  THEN P8 AND P9 ARE THE OUTER LIMITS OF THE SECONDARY GROUP
	MOVE 1,.COMM.+=28	;JJ7=J7-J
	SUB 1,0
	MOVEM 1,JJ7#
;   J7=NUM. OF FULL BEAMS   (1ST DIGIT OF P10=NUM OF ADDED BEAMS)
BM7:	SETZM .COMM.+=31	;7	J10=0
BM5:	KIFIX 1,.COMM.+=9 	;5	J8=R8
	MOVEM 1,.COMM.+=29
	KIFIX 1,.COMM.+=10	;J9=R9
	MOVEM 1,.COMM.+=30
	FLTR 1,.COMM.+=28	;R7=J7
	MOVEM 1,.COMM.+=8 
	FLTR 1,10		;R10=J10
	MOVEM 1,.COMM.+=11
	JSA 16,BMSTF		;CALL BMSTF
	AOS 1,JZ			;JZ=JZ+1
	JUMPL 1,BM1		;IF(JZ)1,2,3          
	JUMPE 1,BM2
BM3:	JRA 16,(16)		;3	RETURN

BM1:	SKIPL RR8		;1	IF(RR8.GE.0)GO TO 8
	JRST BM8
	MOVNI 1,=20		;IF(JX8.GE.-20)GO TO 11
	CAML 1,JX8		;C UNATTACHED PARTIAL BEAM: 
	JRST BM11		;C  P8= -10=ON LEFT, -20=RIGHT, -30=BOTH
	MOVE 1,[10.0]		;RR8=RR8+10
	FADRM 1,RR8
	MOVNI 1,=31		;IF(JX8.EQ.-31)GO TO 11
	CAMN 1,JX8
	JRST BM11
	SOS JX8			;JX8=JX8-1
	SETZM RR9		;RR9=0     C  A PRECAUTION
	MOVNI 1,2		;JZ=JZ-2
	ADDM 1,JZ
BM11:	JSA 16,AMOD		;11	R8=RR8-AMOD(R7,10.0)
	JUMP .COMM.+=8
	JUMP [10.0]
	FSBR 0,RR8
	MOVNM 0,.COMM.+=9
BM10:	MOVE 1,RR9		;10	R9=RR9
	MOVEM 1,.COMM.+=10
	AOS JZ			;JZ=JZ+1
	JRST BM4		;GO TO 4
BM8:	SKIPN JJ10		;8	IF(JJ10.EQ.0)GO TO 9
	JRST BM9		;C NEXT MAKES ONE SECONDARY BEAM GROUP.
	MOVE 1,RR8		;R8=RR8
	MOVEM 1,.COMM.+=9
	JRST BM10		;GO TO 10
BM9:	MOVN 1,[1.0]		;9	R8=-1
	MOVEM 1,.COMM.+=9
	MOVE 1,RR8		;R9=RR8
	MOVEM 1,.COMM.+=10
BM4:	MOVE 1,J		;4	J7=J+JJ
	ADD 1,JJ
	MOVEM 1,.COMM.+=28
	MOVE 1,RR6		;R6=RR6
	MOVEM 1,.COMM.+=7
	MOVE 1,RR3		;R3=RR3
	MOVEM 1,.COMM.+=4
	KIFIX 1,1		;J3=RR3
	MOVEM 1,.COMM.+=26
	MOVE 1,RR4		;R4=RR4
	MOVEM 1,.COMM.+=5
	MOVE 1,RR5		;R5=RR5
	MOVEM 1,.COMM.+=6
	MOVE 1,JJ7		;J10=JJ7
	MOVEM 1,.COMM.+=31	;C J10 IS DISPLACEMENT FOR OTHER BEAMS
	MOVE 1,RSTJ		;RSTJ2=RSTJ
	MOVEM 1,STF+=8
	JRST BM5		;GO TO 5
BM2:	MOVE 1,RR9		;2	R8=RR9
	MOVEM 1,.COMM.+=9
	MOVN 1,[1.0]		;R9=-1
	MOVEM 1,.COMM.+=10
	JRST BM4		;GO TO 4
	END